home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
090
/
byt86oct.arc
/
ALLOC.ARC
/
ALLOC2.MOD
< prev
next >
Wrap
Text File
|
1985-07-12
|
5KB
|
185 lines
IMPLEMENTATION MODULE Alloc2;
(* A storage allocator that tries to be safe about freed blocks.
It detects attempts to access freed blocks by leaving "tombstones"
in the heap.
Copyright 1986 by Jonathan Amsterdam. All Rights Reserved. *)
FROM SYSTEM IMPORT WORD, ADDRESS, TSIZE;
FROM MachineSpecific IMPORT getHeapBottom, getHeapTop, bytesPerWord,
address, cardinal, addrLessThan, writeAddress;
FROM MyTerminal IMPORT fatal;
CONST maxIndex = 32767;
TYPE blockPtr = POINTER TO block;
block = RECORD
size:CARDINAL; (* not including header *)
CASE BOOLEAN OF
TRUE: nextBlock: blockPtr;
| FALSE: contents:ARRAY[0..maxIndex] OF WORD;
END;
END;
VAR heapBottom, heapTop:ADDRESS;
freeList:blockPtr;
blockHeaderSize, minBlockSize:CARDINAL;
PROCEDURE init;
BEGIN
heapBottom := getHeapBottom();
heapTop := getHeapTop();
blockHeaderSize := TSIZE(CARDINAL);
minBlockSize := TSIZE(blockPtr) + blockHeaderSize;
freeList := blockPtr(heapBottom);
freeList^.size :=
(cardinal(heapTop-heapBottom) DIV bytesPerWord) - blockHeaderSize + 1;
freeList^.nextBlock := NIL;
END init;
PROCEDURE blockSize(blockp:blockPtr):CARDINAL;
BEGIN
RETURN blockp^.size;
END blockSize;
PROCEDURE getWord(blockp:blockPtr; n:CARDINAL):WORD;
BEGIN
tombstoneCheck(blockp);
IF n < blockp^.size THEN
RETURN blockp^.contents[n];
ELSE
fatal('getWord: out of bounds');
END;
END getWord;
PROCEDURE setWord(blockp:blockPtr; n:CARDINAL; w:WORD);
BEGIN
tombstoneCheck(blockp);
IF n < blockp^.size THEN
blockp^.contents[n] := w;
ELSE
fatal('setWord: out of bounds');
END;
END setWord;
PROCEDURE allocate(nWords:CARDINAL):blockPtr;
VAR currBlock, prevBlock:blockPtr;
BEGIN
currBlock := freeList;
prevBlock := NIL;
WHILE currBlock <> NIL DO
IF nWords + minBlockSize < currBlock^.size THEN
(* split the block into two, returning the 2nd part *)
DEC(currBlock^.size, nWords+blockHeaderSize);
INC(currBlock, bytesPerWord*(blockHeaderSize + currBlock^.size));
currBlock^.size := nWords;
RETURN currBlock;
ELSIF nWords <= currBlock^.size THEN (* return the whole block *)
link(prevBlock, currBlock^.nextBlock);
RETURN currBlock;
END;
prevBlock := currBlock;
currBlock := currBlock^.nextBlock;
END;
RETURN NIL;
END allocate;
PROCEDURE free(VAR freeBlock:blockPtr);
VAR currBlock, prevBlock, temp:blockPtr;
BEGIN
IF NOT addrBetween(heapBottom, freeBlock, heapTop) THEN
fatal("free: block not in heap");
ELSIF freeBlock^.size = 0 THEN
fatal("free: attempt to free an already freed block");
ELSIF freeBlock^.size - blockHeaderSize < minBlockSize THEN
(* don't attempt to incorporate the block into the freelist *)
freeBlock^.size := 0;
freeBlock := NIL;
ELSE
temp := freeBlock;
INC(freeBlock, bytesPerWord*blockHeaderSize);
freeBlock^.size := temp^.size - blockHeaderSize;
temp^.size := 0;
currBlock := freeList;
prevBlock := NIL;
WHILE (currBlock <> NIL) AND addrLessThan(currBlock, freeBlock) DO
prevBlock := currBlock;
currBlock := currBlock^.nextBlock;
END;
IF currBlock = NIL THEN
freeBlock^.nextBlock := NIL;
link(prevBlock, freeBlock);
ELSE (* freeBlock belongs just before currBlock *)
freeBlock^.nextBlock := currBlock;
link(prevBlock, freeBlock);
END;
tryToMerge(prevBlock, freeBlock, currBlock);
freeBlock := NIL;
END;
END free;
PROCEDURE tryToMerge(lowBlock, middleBlock, highBlock:blockPtr);
BEGIN
IF adjacent(middleBlock, highBlock) THEN
merge(middleBlock, highBlock);
END;
IF adjacent(lowBlock, middleBlock) THEN (* this should be impossible *)
merge(lowBlock, middleBlock);
END;
END tryToMerge;
PROCEDURE adjacent(lowerBlock, higherBlock:blockPtr):BOOLEAN;
BEGIN
RETURN
(lowerBlock <> NIL) AND
(higherBlock <> NIL) AND
(lowerBlock + address(bytesPerWord*(lowerBlock^.size + blockHeaderSize)) =
higherBlock);
END adjacent;
PROCEDURE merge(lowerBlock, higherBlock:blockPtr);
BEGIN
INC(lowerBlock^.size, higherBlock^.size + blockHeaderSize);
lowerBlock^.nextBlock := higherBlock^.nextBlock;
END merge;
PROCEDURE link(prevBlock, linkBlock:blockPtr);
BEGIN
IF prevBlock = NIL THEN
freeList := linkBlock;
ELSE
prevBlock^.nextBlock := linkBlock;
END;
END link;
PROCEDURE addrBetween(low, middle, high:ADDRESS):BOOLEAN;
BEGIN
RETURN (addrLessThan(low, middle) OR (low = middle)) AND
(addrLessThan(middle, high) OR (middle = high));
END addrBetween;
PROCEDURE tombstoneCheck(blockp:blockPtr);
BEGIN
IF blockp^.size = 0 THEN
fatal("attempt to access a freed block");
END;
END tombstoneCheck;
PROCEDURE getFreeList():blockPtr;
(* for debugging only *)
BEGIN
RETURN freeList;
END getFreeList;
BEGIN
init;
END Alloc2.
reeList():blockPtr;
(* for debugging only *)
BEGIN
RETURN freeList;
END getFreeList;
BEGIN
init;
END All